home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tpscrnsv.zip / SCRNSAVE.PAS < prev   
Pascal/Delphi Source File  |  1990-04-01  |  11KB  |  409 lines
  1. {$A-,B-,D+,E-,F+,I-,L+,N-,O-,R-,S-,V-}
  2. {$M 5000,0,0}
  3.  
  4. PROGRAM SCRNSAVE;
  5.  
  6. {Resident portion of Screen Saver, the one that is locked in memory}
  7. {Use SCSVCOMM to communicate with Screen Saver}
  8.  
  9.   Uses CRT,DOS,PSP,DosExten;
  10.  
  11.   TYPE Address=RECORD
  12.                  CASE Boolean OF
  13.                    True:(Ptr:Pointer);
  14.                    False:(Offset, Segment:Word)
  15.                END;
  16.  
  17. { ------------------------------------------------------------------------- }
  18.   CONST Able_to_Install_TSR:Boolean=True;
  19.  
  20.  
  21.   CONST OldStackSS:Word=0;
  22.                 OldStackSP:Word=0;
  23.         OurStackSeg:Word=0;
  24.         OurStackSP:Word=0;
  25.  
  26.         StackSW:Integer=-1;
  27.  
  28.         EndDos:Word=0;
  29.  
  30. { ------------------------Variables----------------------- }
  31.  
  32.  
  33.   VAR Regs:Registers;
  34.  
  35.   VAR OldTimerVec,
  36.       OldKbdVec:Pointer;
  37.  
  38.       DosSeg:Word;
  39.       DosBusy:Word;
  40.  
  41.       OldDTASeg,
  42.       OldDTAOfs,
  43.  
  44.       OurDTASeg,
  45.       OurDTAOfs:Word;
  46.  
  47.       OldBreakStatus:Byte;
  48.  
  49.       TSR_Communication_Routine:Pointer;
  50.  
  51.       TSR_Byte,
  52.       TSR_Communication_Vec:Byte;
  53.       TSR_PSP,
  54.       INT_PSP:Word;
  55.  
  56.       PSP_Array:Array[1..2] Of Word;
  57.       PSP_Counter:Byte;
  58.  
  59.   CONST Counter:Word=0;
  60.         Video_Disabled:Boolean=False;
  61.         PortNum:Word=$3D8;
  62.         TurnOff:Word=$25;
  63.         TurnOn:Word=$2D;
  64.         TimeLimit:Word=1092;
  65.  
  66.  
  67.   CONST TimerInt=$1C;
  68.         KbdInt=$09;
  69.  
  70.         TSR_Suspended:Boolean=False;
  71.  
  72.         PROCEDURE BeginInt;
  73.           Inline($FF/$06/StackSw
  74.                 /$75/$10
  75.                 /$8C/$16/OldStackSS
  76.                 /$89/$26/OldStackSP
  77.                 /$8E/$16/OurStackSeg
  78.                 /$8B/$26/OurStackSP);
  79.  
  80.         PROCEDURE EndInt;
  81.           Inline($FF/$0E/StackSw
  82.                 /$7D/$08
  83.                 /$8E/$16/OldStackSS
  84.                 /$8B/$26/OldStackSP);
  85.  
  86.         PROCEDURE CLI; Inline($FA);
  87.         PROCEDURE STI; Inline($FB);
  88.  
  89. { ****************************CallOldInt******************************** }
  90.  
  91.  PROCEDURE CallOldInt(Sub:Pointer);
  92.  
  93.    BEGIN
  94.      Inline($9C/
  95.             $FF/$5E/$06)
  96.    END;
  97.  
  98.   PROCEDURE New_Clock_Interrupt(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP:Word);
  99.     Interrupt;
  100.  
  101.     BEGIN
  102.       CLI;
  103.  
  104.       CallOldInt(OldTimerVec);
  105.       IF (Not TSR_Suspended) And (Not Video_Disabled) And (Counter>TimeLimit) THEN
  106.         BEGIN
  107.           NoSound;
  108.           Sound(100);
  109.           Delay(100);
  110.           NoSound;
  111.  
  112.           Port[PortNum]:=TurnOff;
  113.           Video_Disabled:=True
  114.         END
  115.           ELSE
  116.             Inc(Counter);
  117.  
  118.     STI
  119.   End; {of New_Clock_Interrupt}
  120.  
  121. { ***********************New_Keyboard_Interrupt***************************** }
  122.  
  123.  PROCEDURE New_Keyboard_Interrupt(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP:Word);
  124.    Interrupt;
  125.  
  126.    BEGIN
  127.      CLI;
  128.  
  129.      Counter:=0;
  130.      IF Video_Disabled THEN
  131.        BEGIN
  132.          Port[PortNum]:=TurnOn;
  133.          Video_Disabled:=False;
  134.  
  135.          {Reset the keyboard}
  136.          TSR_Byte:=Port[$61];
  137.          Port[$61]:=TSR_Byte Or $80;
  138.          Port[$61]:=TSR_Byte;
  139.  
  140.          {Signal end of interrupt}
  141.          CLI;
  142.          Port[$20]:=$20;
  143.          STI;
  144.        END
  145.           ELSE CallOldInt(OldKbdVec);
  146.  
  147.      STI
  148.    END; {of New_Keyboard_Interrupt}
  149.  
  150. { ***************************Install_TSR_Interrupts************************ }
  151.  
  152.   PROCEDURE Install_TSR_Interrupts;
  153.  
  154.     BEGIN
  155.       SetIntVec(TimerInt,@New_Clock_Interrupt);
  156.       SetIntVec(KbdInt,@New_Keyboard_Interrupt);
  157.       {SetIntVec(Int28h,@New_28h);}
  158.       SetIntVec(TSR_Communication_Vec,TSR_Communication_Routine);
  159.       IF StackSw=-1 THEN
  160.         SetIntVec($1B,SaveInt1B)
  161.     END;
  162.  
  163. { ***************************Release_Memory********************************** }
  164.  
  165.      PROCEDURE Release_Memory;
  166.  
  167.          VAR EndDos_plus_1:Word;
  168.  
  169.          BEGIN {Release_Memory}
  170.  
  171.          WHILE (Mem[EndDos:$0000]=$4D) DO
  172.              BEGIN
  173.                  EndDos_plus_1:=EndDos+1;
  174.                  IF MemW[EndDos:$0001]=TSR_PSP THEN
  175.                      Release_Memory_Block(EndDos_plus_1);
  176.  
  177.          EndDos:=EndDos_plus_1+MemW[EndDos:$0003] {Next MCB}
  178.          END
  179.          END;
  180.  
  181. { ************************TSR_Exit******************************************* }
  182.  
  183.   FUNCTION TSR_Exit:Boolean;
  184.  
  185.     VAR Current_Timer_Vec,
  186.         Current_Kbd_Vec:Pointer;
  187.  
  188.     BEGIN {TSR_Exit}
  189.       GetIntVec(TimerInt,Current_Timer_Vec);
  190.       GetIntVec(KbdInt,Current_Kbd_Vec);
  191.  
  192.       IF (Current_Timer_Vec=@New_Clock_Interrupt) And
  193.          (Current_Kbd_Vec=@New_Keyboard_Interrupt) THEN
  194.  
  195.          BEGIN
  196.            SetIntVec(TimerInt,OldTimerVec);
  197.            SetIntVec(KbdInt,OldKbdVec);
  198.            SetIntVec(TSR_Communication_Vec,Nil);
  199.            Release_Memory;
  200.            TSR_Exit:=True
  201.          END
  202.        ELSE
  203.          TSR_Exit:=False
  204.     END; {of TSR_Exit}
  205.  
  206. { *************************Setup*************************************** }
  207.  
  208.   PROCEDURE Setup;
  209.  
  210.     VAR Adr:Word;
  211.         TSR_PSP_Plus_1:Word;
  212.  
  213.     BEGIN {Setup}
  214.       CheckBreak:=False;
  215.  
  216.       OurStackSeg:=SSeg;    {Save TSR's Stack Segment & Stack Pointer}
  217.       Inline($89/$26/OurStackSP);
  218.  
  219.       Get_DOS_Busy_Flag_Address(DosSeg,DosBusy);
  220.       Get_DTA_Address(OurDTASeg,OurDTAOfs);
  221.       TSR_PSP:=PSP_Segment;
  222.       EndDos:=End_of_DOS_Memory;
  223.  
  224.       PSP_Counter:=0;
  225.       Adr:=0;
  226.       WHILE (PSP_Counter<2) And (((DosSeg Shl 4)+Adr)<(EndDos Shl 4)) DO
  227.         BEGIN
  228.           IF MemW[DosSeg:Adr]=TSR_PSP THEN
  229.             BEGIN
  230.               TSR_PSP_Plus_1:=TSR_PSP+1;
  231.               Set_PSP_Segment(TSR_PSP_Plus_1);
  232.               IF MemW[DosSeg:Adr]=TSR_PSP_Plus_1 THEN
  233.                 Inc(PSP_Counter);
  234.               PSP_Array[PSP_Counter]:=Adr;
  235.               Set_PSP_Segment(TSR_PSP)
  236.             END;
  237.           Inc(Adr)
  238.         END; {of While...}
  239.  
  240.       GetIntVec(TimerInt,OldTimerVec);
  241.       GetIntVec(KbdInt,OldKbdVec);
  242.  
  243.     END; {of Setup}
  244.  
  245. { *****************************DupCheck*********************************** }
  246.  
  247.   FUNCTION DupCheck(VAR TSR_Signature:String;
  248.                         TSR_Communication_Rtn:Pointer):Byte;
  249.  
  250.     VAR Vec:Word;
  251.         Dif:Word;
  252.         IntrAddress:Address;
  253.         RtnAddress:Address Absolute TSR_Communication_Rtn;
  254.         Current_Signature:String;
  255.         Length_of_TSR_Signature:Byte Absolute TSR_Signature;
  256.         Done:Boolean;
  257.         Current_Comm_Rtn:Pointer;
  258.  
  259.     BEGIN {DupCheck}
  260.       Dif:=DSeg-RtnAddress.Segment;
  261.       Vec:=$60;
  262.       Done:=False;
  263.  
  264.       WHILE (Vec<$68) And Not Done DO
  265.         BEGIN
  266.           GetIntVec(Vec,IntrAddress.Ptr);
  267.           IF IntrAddress.Ptr=Nil THEN
  268.             BEGIN {If TSR has not yet been installed...}
  269.               TSR_Communication_Routine:=TSR_Communication_Rtn;
  270.               GetIntVec(Vec,Current_Comm_Rtn);
  271.               TSR_Communication_Vec:=Vec;
  272.               DupCheck:=0;
  273.               Done:=True
  274.             END
  275.               ELSE {If TSR may have been installed...}
  276.                 BEGIN
  277.                   Move(Mem[IntrAddress.Segment+Dif:Ofs(TSR_Signature)],
  278.                                   Current_Signature,Length_of_TSR_Signature+1);
  279.                   IF Current_Signature=TSR_Signature THEN
  280.                     BEGIN
  281.                       DupCheck:=Vec;
  282.                       TSR_Communication_Vec:=Vec;
  283.                       Able_to_Install_TSR:=True;
  284.                       Done:=True
  285.                     END
  286.                       ELSE Inc(Vec)
  287.                 END {of If TSR may have been installed...}
  288.         END; {of While...}
  289.  
  290.         IF Not Done THEN
  291.           BEGIN
  292.            DupCheck:=0;
  293.            Able_to_Install_TSR:=False
  294.           END
  295.       END; {of DupCheck}
  296.  
  297. { ---------------------------------------------------------------------------}
  298.    CONST TSR_Signature:String='The SCRNSAVE - Memory-resident Program by Ilya Shlyakhter';
  299.  
  300.    VAR TSR_Int:Byte;
  301.        TSR_AX:Word;
  302.        TSR_BX:Word;
  303.  
  304. { *******************************Stop_TSR************************************ }
  305.  
  306.   PROCEDURE Stop_TSR;
  307.  
  308.     BEGIN
  309.       Writeln;
  310.       IF TSR_Exit THEN
  311.         Writeln('SCRNSAVE unloaded.')
  312.        ELSE Writeln('Unable to unload SCRNSAVE - other TSR has been installed.')
  313.     END;
  314.  
  315.  
  316. { ****************************Suspend_TSR********************************** }
  317.  
  318.  PROCEDURE Suspend_TSR;
  319.  
  320.    BEGIN
  321.      TSR_Suspended:=True;
  322.      Writeln('SCRNSAVE suspended.');
  323.      Write('Enter SCRNSAVE RESTART to restart Screen Saver.')
  324.    END;
  325.  
  326.  
  327.  { ****************************Restart_TSR********************************** }
  328.  
  329.  PROCEDURE Restart_TSR;
  330.  
  331.    BEGIN
  332.      TSR_Suspended:=False;
  333.      Writeln('SCRNSAVE restarted.')
  334.    END;
  335.  
  336. { ***************************MyCommRtn************************************ }
  337.  
  338.   PROCEDURE MyCommRtn(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP:Word); Interrupt;
  339.  
  340.     BEGIN
  341.       TSR_AX:=AX;
  342.       IF TSR_AX=5 THEN
  343.         BEGIN
  344.           IF TSR_Suspended THEN AX:=5 ELSE AX:=6
  345.         END
  346.           ELSE
  347.             IF TSR_AX=8 THEN
  348.               BEGIN
  349.                 TSR_BX:=BX;
  350.                 TimeLimit:=TSR_BX;
  351.                 Writeln('Time limit has been set to ',TimeLimit,' ticks (1 second=18.2 ticks)')
  352.               END
  353.                 ELSE
  354.  
  355.       CASE TSR_AX OF
  356.         1:Stop_TSR;
  357.         2:Suspend_TSR;
  358.         3:Restart_TSR
  359.       END; {of Case}
  360.  
  361.    STI
  362.  END;
  363.  
  364.  
  365.  
  366. { **************************Outer block of the TSR*********************** }
  367.  
  368.   BEGIN
  369.     TSR_Int:=DupCheck(TSR_Signature,@MyCommRtn);
  370.  
  371.     IF TSR_Int>0 THEN
  372.       BEGIN
  373.  
  374.         Writeln;
  375.         Writeln('SCRNSAVE already installed');
  376.         Writeln;
  377.  
  378.       END {of prompting the user that we are already installled}
  379.         ELSE {If TSR has not been installed yet...}
  380.           IF Not Able_to_Install_TSR THEN
  381.             BEGIN
  382.               Writeln;
  383.               Writeln('Unable to install SCRNSAVE - too many TSR''s have'+
  384.                       ' been installed.')
  385.             END
  386.               ELSE
  387.                 BEGIN
  388.                   Writeln('                  *****SCRNSAVE*****');
  389.                   Writeln;
  390.  
  391.                   Write('Going resident...');
  392.  
  393.                   FillChar(Regs,SizeOf(Regs),0);
  394.                   Intr($11,Regs);
  395.                   IF (Regs.AL And $30)=$30 THEN
  396.                     BEGIN
  397.                       PortNum:=$3B8;
  398.                       TurnOn:=$29;
  399.                       TurnOff:=$21
  400.                     END;
  401.  
  402.                   Setup;
  403.                   Writeln('done.');
  404.                   Writeln;
  405.                   Install_TSR_Interrupts;
  406.                   Keep(0)
  407.                 END {of installing the TSR}
  408.    END. {of program}
  409.